start:
CLEAR,30000
IF FRE(-1)<400000 THEN CLEAR ,170000,30000:DIM da$(102,50),l(102):fr=7
IF FRE(-1)>400000 THEN CLEAR ,250000,30000:DIM da$(202,50),l(202):fr=10
DIM pf$(50),merkefile$(50)
OPEN "ram:tiuda" FOR APPEND AS 2
IF LOF(2)<=0 THEN 
 ta$=DATE$:ta$=MID$(ta$,4,2)+"."+LEFT$(ta$,2)+"."+RIGHT$(ta$,4):ort$="Immenstaad":drive$="df0:"
ELSE
 CLOSE#2:OPEN "ram:tiuda" FOR INPUT AS#2:INPUT#2,ort$:INPUT#2,ta$,drive$
END IF
CLOSE #2
SCREEN 1,630,222,1,2:WINDOW 3,"  --  Leichtathletikdatenverwaltung V1.0   -- © by NEUDELSOFT",(0,0)-(620,200),0,1
PALETTE 0,0,0,0:PALETTE 1,0.1,1,0.1:COLOR 1,0
MENU 1,0,1,"Dateityp":MENU 1,1,1,"Einzeldisziplin":MENU 1,2,1,"Dreikampf":MENU 1,3,1,"Vierkampf":MENU 1,4,1,"Fünfkampf"
MENU 2,0,1,"Arbeit":MENU 2,1,1,"Eingeben":MENU 2,2,1,"Suchen":MENU 2,3,1,"Sortieren"
MENU 3,0,1,"Drucken":MENU 3,1,1,"Erste Leistungen":MENU 3,2,1,"Erste Wettkampfleistungen":MENU 3,3,1,"Listenbild"
MENU 4,0,1,"System":MENU 4,1,1,"Laden":MENU 4,2,1,"Speichern":MENU 4,3,1,"Neue Datei eröffnen":MENU 4,4,1,"Preferences":MENU 4,5,1,"Ende":MENU 4,6,1,"About"
REM MENU 4,7,1,"Punktlisten-Editor"
MENU ON
mn:
tr=0
a$=INKEY$:a$=INKEY$:m1=MENU(0):IF m1=0 THEN GOTO mn
IF dt=0 THEN IF m1>1 AND m1<3 THEN mn
ON m1 GOTO dateityp,arbeit,drucken,sys
GOTO mn
drucken:
m2=MENU(1)
ON m2 GOTO erstel,erstew,pliste
GOTO mn
pliste:
CLS:PRINT "Name des Athleten:"
LINE INPUT such$
IF such$="" THEN CLS:GOTO mn
such$=UCASE$(such$)
PRINT :PRINT 
PRINT "Filepool"
pool=0
poolwarte:
pool=pool+1
PRINT "Bitte geben Sie den Namen des "pool".Files an !"
LINE INPUT pf$(pool)
IF pf$(pool)="" AND pool>1 THEN pool=pool-1:GOTO pool2
IF pf$(pool)="*" AND pool=1 THEN
 FOR a=1 TO merkefile
  pf$(a)=merkefile$(a)
 NEXT a
 pool=merkefile:GOTO pool2
END IF
IF pf$(pool)="" AND pool=1 THEN pool=0
GOTO poolwarte
pool2:
FOR a=1 TO pool
 merkefile$(a)=pf$(a)
NEXT a
merkefile=pool
PRINT :PRINT "Bitte geben Sie das Jahr an !"
LINE INPUT jahr$
PRINT :PRINT "Bitte schalten Sie den Drucker ein !"
SLEEP:SLEEP
LPRINT " ";
LPRINT CHR$(27)"[";6;"s";
LPRINT CHR$(27)"[";72;"t";
LPRINT CHR$(27)"[";7;"q";
LPRINT CHR$(27)"[4m";
LPRINT CHR$(27)"[1m";
prenn=0
PRINT :PRINT "Bitte legen Sie die Disk mit diesen Files ein !!!"
SLEEP:SLEEP
pkenn=1
FOR pa=1 TO pool
 GOSUB laden
 found=0
 FOR pb=1 TO d
  IF UCASE$(LEFT$(da$(1,pb),LEN(such$)))=such$ THEN found=pb:pb=d
 NEXT pb
 IF found>0 THEN
  IF prenn=0 THEN 
   LPRINT:LPRINT
   LPRINT "Alle Leistungen von "da$(1,found)" (*"da$(2,found)") im Jahre "jahr$
   LPRINT CHR$(27)"[22m";:
   LPRINT CHR$(27)"[24m";
   LPRINT:LPRINT
   prenn=1
  END IF
  LPRINT CHR$(27)"[4m";
  LPRINT CHR$(27)"[3m";
  IF dt=1 THEN 
   LPRINT di$(1)
  ELSEIF dt=3 THEN
   LPRINT "Dreikampf (";
  ELSEIF dt=4 THEN 
   LPRINT "Vierkampf (";
  ELSE 
   LPRINT "Fünfkampf"
   LPRINT "  (";
  END IF
  IF dt>1 THEN
   FOR a=1 TO dt
    LPRINT di$(a)" ";
    IF a<dt THEN LPRINT",";
   NEXT a
   LPRINT " )"
  END IF 
  LPRINT CHR$(27)"[23m";
  LPRINT CHR$(27)"[24m";
  LPRINT:LPRINT
  FOR pb=1 TO l(found)
    tr=0
    IF dt=1 THEN 
     IF INSTR(1,da$(5*pb-2,found),":")=0 THEN
      dr$=da$(5*pb-2,found)
      drprp:
      IF INSTR(1,dr$,".")>0 THEN
       MID$(dr$,INSTR(1,dr$,"."),1)=","
       GOTO drprp
      END IF
      IF INSTR(1,dr$,",")=0 THEN dr$=dr$+","
      drpr2p:
      IF LEN(dr$)<4 AND VAL(dr$)<10 THEN dr$=dr$+"0":GOTO drpr2p
      IF LEN(dr$)<5 AND VAL(dr$)<100 AND VAL(dr$)>10 THEN dr$=dr$+"0":GOTO drpr2p
      IF tr=2 AND LEN(dr$)<5 THEN dr$=dr$+"0":GOTO drpr2p
      IF tr>0 THEN RETURN
     ELSE  
      b=LEN(STR$(VAL(da$(5*pb-2,found))))
      dr$=RIGHT$(da$(5*pb-2,found),LEN(da$(5*pb-2,found))-b)
      tr=2:GOSUB drprp
      dr$=STR$(VAL(da$(5*pb-2,found)))+":"+dr$
     END IF
     druckl$=dr$+" "+e$(1)
     druckl$=druckl$+" erzielt ":
     IF UCASE$(da$(5*pb+(dt-2),found))="W" THEN
      druckl$=druckl$+"im Wettkampf"
     ELSEIF UCASE$(da$(5*pb+(dt-2),found))="R" THEN
      druckl$=druckl$+"bei Rückenwind"
     ELSEIF UCASE$(da$(5*pb+(dt-2),found))="S" THEN
      druckl$=druckl$+"in der Staffel"
     ELSE  
      druckl$=druckl$+"im Training"
     END IF
     druckl$=druckl$+" am "+da$(5*pb+dt,found)+" in "+da$(5*pb+dt-1,found)
     drucka$="Sportabzeichen :"
     IF UCASE$(da$(5*pb+dt+1,found))="J" THEN 
      drucka$=drucka$+" ja"
     ELSE
      drucka$=drucka$+" nein"
     END IF
     LPRINT druckl$
     LPRINT drucka$
     LPRINT
    END IF      
    IF dt>1 THEN
     druckl$=da$(5*pb+(dt-2)+((dt-1)*(pb-1)),found)+" Punkte"
     druckl$=druckl$+" ("
     FOR b=1 TO dt
      IF INSTR(1,da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found),":")=0 THEN
       tr=1:dr$=da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found):GOSUB drprp
      ELSE                                        
       c=LEN(STR$(VAL(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found))))
       dr$=RIGHT$(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found),LEN(da$(5*pb+(-3+b)+((dt-1)*(pb-1)),found))-c)
       tr=2:GOSUB drprp
       dr$=STR$(VAL(da$(5*pb-3+b+((dt-1)*(pb-1)),found)))+":"+dr$
      END IF
      druckl$=druckl$+" "+dr$+" "+e$(b)
      IF b<dt THEN druckl$=druckl$+","
     NEXT b
     druckl$=druckl$+" )"
     druckk$="erzielt am "+da$(5*pb+dt+((dt-1)*(pb-1)),found)+" in "+da$(5*pb+dt-1+((dt-1)*(pb-1)),found)
     drucka$="Abzeichen :"
     IF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="G" THEN
      drucka$=drucka$+" Gold"
     ELSEIF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="S" THEN
      drucka$=drucka$+" Silber"
     ELSEIF UCASE$(da$(5*pb+dt+1+((dt-1)*(pb-1)),found))="B" THEN
      drucka$=drucka$+" Bronze"
     ELSE
      drucka$=drucka$+" keins" 
     END IF
     LPRINT druckl$
     LPRINT druckk$
     LPRINT drucka$
     LPRINT
    END IF
   NEXT pb
   LPRINT
  END IF
 NEXT pa 
 pkenn=0:prenn=0
LPRINT CHR$(12) 
CLS:GOTO mn  
abfrage:
CLS:PRINT "Welche Bezeichnung (Altersklasse) ?"
LINE INPUT a$
RETURN
erstew:
IF d=0 THEN mn
GOSUB abfrage
b$="Bestleistungen"
GOSUB pref
platz=0
FOR a=1 TO d
FOR x=1 TO l(a)
IF dt>1 OR UCASE$(da$(5*x+(dt-2),a))="W" THEN
 warn=1:wurm=x:platz=platz+1:GOSUB drpf
 x=l(a)
END IF 
NEXT x
warn=0
NEXT a
LPRINT CHR$(12) 
CLS
GOTO mn
pref:
CLS:PRINT "Bitte Drucker einschalten !!"
SLEEP:SLEEP
LPRINT " ";
LPRINT CHR$(27)"[";6;"s";
LPRINT CHR$(27)"["71"t";
LPRINT CHR$(27)"["5"q";
LPRINT 
LPRINT CHR$(27)"[6w";
LPRINT b$" "a$
LPRINT CHR$(27)"[5w";
LPRINT:LPRINT CHR$(27)"[4m";
LPRINT CHR$(27)"[1m";
IF dt=1 THEN 
 LPRINT di$(1)
ELSEIF dt=3 THEN
 LPRINT "Dreikampf (";
ELSEIF dt=4 THEN 
 LPRINT "Vierkampf (";
ELSE 
 LPRINT "Fünfkampf (";
END IF
IF dt>1 THEN
 FOR a=1 TO dt
  LPRINT " "di$(a)" ";
  IF a<dt THEN LPRINT",";
 NEXT a
 LPRINT " )"
END IF 
LPRINT CHR$(27)"[22m";:LPRINT CHR$(27)"[24m";:LPRINT
RETURN
erstel:
IF d=0 THEN mn
GOSUB abfrage
b$="Erste Leistungen"
GOSUB pref
platz=0
FOR a=1 TO d
wurm=1:platz=platz+1
drpf:
 druckn$=da$(1,a)
 druckb$=da$(2,a)
 IF dt=1 THEN 
  IF INSTR(1,da$(5*wurm-2,a),":")=0 THEN
   dr$=da$(5*wurm-2,a)
   drpr:
   IF INSTR(1,dr$,".")>0 THEN
    MID$(dr$,INSTR(1,dr$,"."),1)=","
    GOTO drpr
   END IF
   IF INSTR(1,dr$,",")=0 THEN dr$=dr$+","
   drpr2:
   IF LEN(dr$)<4 AND VAL(dr$)<10 THEN dr$=dr$+"0":GOTO drpr2
   IF LEN(dr$)<5 AND VAL(dr$)<100 AND VAL(dr$)>=10 THEN dr$=dr$+"0":GOTO drpr2
   IF tr=2 AND LEN(dr$)<5 THEN dr$=dr$+"0":GOTO drpr2
   IF tr>0 THEN RETURN
  ELSE
   b=LEN(STR$(VAL(da$(5*wurm-2,a))))
   dr$=RIGHT$(da$(5*wurm-2,a),LEN(da$(5*wurm-2,a))-b)
   tr=2:GOSUB drpr 
   dr$=STR$(VAL(da$(5*wurm-2,a)))+":"+dr$
  END IF
  druckl$=dr$+" "+e$(1)
  druckk$="erzielt ":
  IF UCASE$(da$(5*wurm+(dt-2),a))="W" THEN
   druckk$=druckk$+"im Wettkampf"
  ELSEIF UCASE$(da$(5*wurm+(dt-2),a))="R" THEN
   druckk$=druckk$+"bei Rückenwind"
  ELSE  
   druckk$=druckk$+"im Training"
  END IF
  druckk$=druckk$+" am "+da$(5*wurm+dt,a)+" in "+da$(5*wurm+dt-1,a)
  drucka$="Sportabzeichen :"
  IF UCASE$(da$(5*wurm+dt+1,a))="J" THEN 
   drucka$=drucka$+" ja"
  ELSE
   drucka$=drucka$+" nein"
  END IF
 END IF      
 IF dt>1 THEN
  druckl$=da$(5+(dt-2),a)+" Punkte"
  druckzl$="   ("
  FOR b=1 TO dt
   IF INSTR(1,da$(5+(-3+b),a),":")=0 THEN
    tr=1:dr$=da$(5+(-3+b),a):GOSUB drpr
   ELSE
    c=LEN(STR$(VAL(da$(5+(-3+b),a))))
    dr$=RIGHT$(da$(5-3+b,a),LEN(da$(5-3+b,a))-c)
    tr=1:GOSUB drpr
    dr$=STR$(VAL(da$(5-3+b,a)))+":"+dr$
   END IF
   druckzl$=druckzl$+" "+dr$+" "+e$(b)
   IF b<dt THEN druckzl$=druckzl$+","
  NEXT b
  druckzl$=druckzl$+" )"
  druckk$="erzielt am "+da$(5+dt,a)+" in "+da$(5+dt-1,a)
  drucka$="Abzeichen :"
  IF UCASE$(da$(5+dt+1,a))="G" THEN
   drucka$=drucka$+" Gold"
  ELSEIF UCASE$(da$(5+dt+1,a))="S" THEN
   drucka$=drucka$+" Silber"
  ELSEIF UCASE$(da$(5+dt+1,a))="B" THEN
   drucka$=drucka$+" Bronze"
  ELSE
   drucka$=drucka$+" keins" 
  END IF
 END IF
 GOSUB druck
 IF warn=1 THEN RETURN
NEXT a 
LPRINT CHR$(12)
CLS
GOTO mn
druck:
LPRINT USING"##";platz;
LPRINT".";
LPRINT CHR$(27)"[3m";
LPRINT druckn$;
LPRINT CHR$(27)"[23m";
LPRINT " ( "druckb$" ) : "druckl$
IF dt>1 THEN LPRINT druckzl$
LPRINT "   "druckk$
LPRINT "   "drucka$
LPRINT
RETURN
sys:
m2=MENU (1):IF m2=0 THEN mn
ON m2 GOTO laden,speichern,neuedaten,datum,schluss,about,pedi
GOTO mn
pedi:
CLS:PRINT "Wollen Sie wirklich den Editor laden (j/n) ?"
a$="":WHILE a$="":a$=INKEY$:WEND
IF UCASE$(a$)<>"J" THEN mn
WINDOW CLOSE 3:SCREEN CLOSE 1:LOAD "Peditor",r
about:
LOCATE 3,10:PRINT "Dieses Programm ist eine NEUDELSOFT-Produktion, die speziell
LOCATE 5,9:PRINT "für den TUS Immenstaad auf einem Amiga 2000 geschrieben wurde."
LOCATE 7,20:PRINT "Programmed by A.Neumann ©1988 by Neudelsoft"
LOCATE 9,1:PRINT "Special Greetings to:Danny,Karsten,Marko,Alex,J+J Himpel,Robert,Hartmann,Pit,..."
SLEEP:SLEEP:CLS:GOTO mn 
datum:
LOCATE 2,10:PRINT "Preferences Version 1.00"
LOCATE 5,5:PRINT "Datum............:";ta$
LOCATE 8,5:PRINT "Ort..............:";ort$
LOCATE 11,5:PRINT "Laufwerk.........:";drive$
LOCATE 17,5:PRINT "Ende.............................Ende"
prefwarte:
Test=MOUSE(0)
WHILE MOUSE(0)=0:WEND
y=MOUSE(2)
po=1
IF y>27 AND y<45 THEN
 prefwarte1:
 tx=21*8+po*8:
 LINE (tx,41)-(tx+8,41),1
 a$=INKEY$:WHILE a$="":a$=INKEY$:WEND
 IF a$=CHR$(8) AND po>1 THEN 
  LINE (tx,41)-(tx+8,41),0
  po=po-1:IF MID$(ta$,po,1)="." THEN po=po-1
 END IF
 IF a$=CHR$(13) THEN LINE (tx,41)-(tx+8,41),0:po=0:GOTO prefwarte
 IF a$=" " AND po<10 THEN
  LINE (tx,41)-(tx+8,41),0:po=po+1
  IF MID$(ta$,po,1)="." THEN po=po+1
 END IF
 IF VAL(a$)=0 AND a$<>"0" THEN prefwarte1
 LOCATE 5,po+22:PRINT a$;
 MID$(ta$,po,1)=a$
 LINE (tx,41)-(tx+8,41),0:IF po<10 THEN po=po+1
 IF MID$(ta$,po,1)="." THEN po=po+1
 GOTO prefwarte1
ELSEIF y>51 AND y<69 THEN
 LOCATE 8,23:PRINT SPACE$(80);:LOCATE 8,23:LINE INPUT a$
 IF a$<>"" THEN ort$=a$
 LOCATE 8,23:PRINT ort$
ELSEIF y>75 AND y<93 THEN
 LOCATE 11,23:PRINT SPACE$(80);:LOCATE 11,23:LINE INPUT a$
 IF a$<>"" THEN drive$=a$
 LOCATE 11,23:PRINT drive$
ELSEIF y>123 AND y<141 THEN
 dasa:
 CLS
 OPEN "ram:tiuda" FOR OUTPUT AS #2
 PRINT#2,ort$
 PRINT#2,ta$
 PRINT#2,drive$
 CLOSE #2
 GOTO mn
END IF
GOTO prefwarte
schluss:
LOCATE 1,1:PRINT "Wollen Sie das Programm beenden ?"
a$=""
WHILE a$><"j" AND a$<>"n"
 a$=INKEY$
WEND
IF a$="n" THEN CLS:GOTO mn
KILL "ram:tiuda"
MENU RESET:WINDOW CLOSE 3:SCREEN CLOSE 1:SYSTEM
neuedaten:
LOCATE 1,1:PRINT "Wollen Sie wirklich das Programm neu starten [die Daten sind gespeichert ?]"
a$=""
WHILE a$<>"j" AND a$<>"n"
 a$=INKEY$
WEND
IF a$="n"THEN CLS:GOTO mn
RUN
speichern:IF d=0 THEN GOTO mn
LOCATE 1,1:PRINT "Wollen Sie wirklich speichern ? [J/N] "
a$=""
WHILE a$<>"j" AND a$<>"n"
 a$=INKEY$
WEND
IF a$="n" THEN CLS:GOTO mn
IF oldfile$<>"" THEN
 PRINT :PRINT "Bleiben Sie beim Filenamen `"oldfile$"` ? (J/N)"
 a$=""
 WHILE a$<>"j" AND a$<>"n"
  a$=INKEY$
 WEND
 IF a$="j" THEN fin$=oldfile$:GOTO readysaven
END IF 
PRINT :LINE INPUT "Filename:";fin$
oldfile$=fin$
readysaven:
PRINT :PRINT "Legen Sie bitte die Datendisk in Drive "drive$" und warten Sie bis die LED aus ist."
SLEEP:SLEEP
OPEN drive$+fin$ FOR OUTPUT AS #2
PRINT #2,dt
FOR a=1 TO dt:PRINT#2,di$(a):PRINT #2,e$(a):NEXT a
IF dt>1 THEN
 FOR a=1 TO dt
  WRITE#2,punktfile$(a)
 NEXT a
END IF
PRINT #2,d                    
FOR a=1 TO d:
WRITE#2,da$(1,a):WRITE#2,da$(2,a)
PRINT #2,l(a)
FOR c=1 TO l(a)
FOR b=1 TO dt:WRITE#2,da$(5*c+(-3+b)+((dt-1)*(c-1)),a)
NEXT b
WRITE#2,da$(5*c+(dt-2)+((dt-1)*(c-1)),a)
WRITE#2,da$(5*c+(dt-1)+((dt-1)*(c-1)),a)
WRITE#2,da$(5*c+dt+((dt-1)*(c-1)),a)
WRITE#2,da$(5*c+dt+1+((dt-1)*(c-1)),a)
NEXT c:NEXT a:CLOSE #2:CLS
GOTO mn
laden:
IF pkenn=1 THEN la2
LOCATE 1,1:PRINT "Wollen Sie wirklich laden ? [J/N] "
a$=""
WHILE a$><"j" AND a$<>"n"
 a$=INKEY$
WEND
IF a$="n" THEN CLS:GOTO mn
IF oldfile$<>"" THEN
 PRINT :PRINT "Bleiben Sie beim Filenamen `"oldfile$"` ?(J/N)"
 a$=""
 WHILE a$<>"j" AND a$<>"n"
  a$=INKEY$
 WEND
 IF a$="j" THEN fin$=oldfile$:GOTO readyladen
END IF
PRINT :LINE INPUT "Filename:";fin$
oldfile$=fin$
readyladen:
PRINT :PRINT "Legen Sie bitte die Datendisk in Drive "drive$" und warten Sie, bis die LED aus ist."
SLEEP:SLEEP
la2:
IF pkenn=1 THEN fin$=pf$(pa)
IF d=0 THEN d=1
FOR a=1 TO d
 l(a)=0
NEXT a
OPEN drive$+fin$ FOR INPUT AS #2
INPUT #2,dt
FOR a=1 TO dt:INPUT #2,di$(a):INPUT #2,e$(a):NEXT a
IF dt>1 THEN
 FOR a=1 TO dt
  INPUT#2,punktfile$(a)
 NEXT a
END IF
INPUT #2,d
FOR a=1 TO d
INPUT #2,da$(1,a):INPUT #2,da$(2,a)
INPUT #2,l(a)                                        
FOR c=1 TO l(a)
FOR b=1 TO dt:INPUT #2,da$(5*c+(-3+b)+((dt-1)*(c-1)),a)
NEXT b
INPUT #2,da$(5*c+(dt-2)+((dt-1)*(c-1)),a)
INPUT #2,da$(5*c+(dt-1)+((dt-1)*(c-1)),a)
INPUT #2,da$(5*c+dt+((dt-1)*(c-1)),a)
INPUT #2,da$(5*c+dt+1+((dt-1)*(c-1)),a)
NEXT c:NEXT a:CLOSE #2:CLS:FOR a=1 TO 4:MENU 1,a,0:NEXT a
IF pkenn=1 THEN RETURN
GOTO mn
dateityp:
m2=MENU(1):fo=0
WINDOW 4," - Dateityp -",(0,0)-(500,200),0,1
IF m2>1 THEN m2=m2+1
dt=m2
FOR a=1 TO m2
 PRINT a".Diziplin,Einheit [q,q] für Ende"
 INPUT di$(a),e$(a):IF di$(a)="q" AND e$(a)="q" THEN fo=1:a=m2
 REM IF dt>1 THEN 
 REM  PRINT "In welchem File sind die Punktzahlen ?"
 REM WINDOW 5,"Request",(300,100)-(600,150),0,1
 REM OPEN "SYS:Fredl" FOR INPUT AS #1
 REM INPUT #1,a$
 REM Fredl:
 REM IF LEN(a$)<3 THEN Fredl2
 REM WINDOW OUTPUT 5
 REM CLS:PRINT :PRINT a$
 REM b$="":WHILE b$="":b$=INKEY$:WEND
 REM IF b$<>CHR$(13) THEN
 REM  Fredl2:
 REM  IF EOF(1)=-1 THEN CLOSE#1:OPEN "SYS:Fredl" FOR INPUT AS #1
 REM  INPUT#1,a$:GOTO Fredl
 REM  END IF 
 REM CLOSE #1
 REM punktfile$(a)=a$
 REM WINDOW CLOSE 5 
 REM END IF
NEXT a 
WINDOW CLOSE 4
IF fo=1 THEN GOTO mn
mnaus:
FOR a=1 TO 4:MENU 1,a,0:NEXT a:GOTO mn
arbeit:
m2=MENU(1)
ON m2 GOTO eingabe,suchen,sortieren
GOTO mn
sortieren:
LOCATE 1,1:PRINT "Wonach sortieren:"
PRINT "Leistungen e. Athleten  > [1]  Leistungen e. Athleten  < [2]"
PRINT "Alle ersten Leistungen  > [3]  Alle ersten Leisungen   < [4]"
PRINT "Alle Bestleistungen     > [5]  Alle Bestleistungen     < [6]"
PRINT "Namen alphabetisch        [7]  Geburtstag                [8]"
PRINT "Treffen Sie Ihre Wahl ... [9] = Menu"
a$=""
WHILE a$<"1" OR a$>"9"
 a$=INKEY$
WEND
mo=VAL(a$)
ON mo GOTO ekg,ekk,abg,abk,aeg,aek,na,ga
CLS:GOTO mn
ekg:
IF dt>1 THEN mo=2
GOSUB ksuch
PRINT "Leistungen werden nach > sortiert."
GOTO s2
ekk:
ksuch:
LINE INPUT "Für welchen Athleten :";su$
IF su$="" THEN CLS:GOTO mn
IF su$="*" THEN za=d:fo=za:GOTO pr
fo=0:za=1
FOR a=1 TO d
IF UCASE$(LEFT$(da$(1,a),LEN(su$)))=UCASE$(su$) THEN fo=a:a=d
NEXT a
IF fo=0 THEN PRINT "Nicht gefunden !!!!":SLEEP:SLEEP:CLS:GOTO mn
pr:
PRINT  da$(1,fo)" gefunden.Gespeicherte Leistungen:"l(fo):IF mo=1 THEN IF su$<>"*" OR za=d THEN RETURN
PRINT "Leistungen werden nach < sortiert.
s2:
IF l(fo)<=1 THEN GOTO zaender
FOR z=1 TO l(fo)
FOR dd=1 TO l(fo)-1
IF mo=2 AND dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)=da$(3,1) THEN
 IF VAL(da$(5*(dd+1)+(-3+1)+((dt-1)*((dd+1)-1)),fo))<VAL(da$(5*dd+(-3+1)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
END IF
IF mo=1 AND dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)=da$(3,1) THEN
 IF VAL(da$(5*(dd+1)+(-3+1)+((dt-1)*((dd+1)-1)),fo))>VAL(da$(5*dd+(-3+1)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
END IF
IF dt=1 AND RIGHT$(STR$(VAL(da$(3,1))),LEN(STR$(VAL(da$(3,1))))-1)<>da$(3,1) THEN
 z1$=STR$(VAL(LEFT$(da$(5*dd+(-3+dt)+((dt-1)*(dd-1)),fo),2)))
 z2$=STR$(VAL(LEFT$(da$(5*(dd+1)+(-3+dt)+((dt-1)*((dd+1)-1)),fo),2)))
 z1$=z1$+RIGHT$(da$(5*dd+(-3+dt)+((dt-1)*(dd-1)),fo),4)
 z2$=z2$+RIGHT$(da$(5*(dd+1)+(-3+dt)+((dt-1)*((dd+1)-1)),fo),4)
 IF mo=2 AND VAL(z2$)<VAL(z1$) THEN GOTO s2ein
 IF mo=1 AND VAL(z2$)>VAL(z1$) THEN GOTO s2ein
END IF
IF dt>1 THEN
 IF VAL(da$(5*(dd+1)+(dt-2)+((dt-1)*((dd+1)-1)),fo))>VAL(da$(5*dd+(dt-2)+((dt-1)*(dd-1)),fo)) THEN GOTO s2ein
END IF
GOTO s2aus
s2ein:
FOR a=1 TO dt
 SWAP da$(5*dd+(-3+a)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(-3+a)+((dt-1)*((dd+1)-1)),fo)
NEXT a
SWAP da$(5*dd+(dt-2)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(dt-2)+((dt-1)*((dd+1)-1)),fo)
SWAP da$(5*dd+(dt-1)+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+(dt-1)+((dt-1)*((dd+1)-1)),fo)
SWAP da$(5*dd+dt+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+dt+((dt-1)*((dd+1)-1)),fo)
SWAP da$(5*dd+dt+1+((dt-1)*(dd-1)),fo),da$(5*(dd+1)+dt+1+((dt-1)*((dd+1)-1)),fo)
s2aus:
NEXT dd:NEXT z:
zaender:
za=za-1:IF za=0 THEN CLS:GOTO mn 
fo=za:GOTO pr
abg:
PRINT "Die ersten Leistungen werden nach > sortiert !!!"
GOTO sort
abk:
PRINT "Die ersten Leistungen werden nach < sortiert !!!"
IF dt>1 THEN mo=3
GOTO sort
aeg:
PRINT "Die ersten Wettkampf-Leistungen werden nach > sortiert !!"
GOTO sort
aek:
PRINT "Die ersten Wettkampf-Leistungen werden nach < sortiert !!"
GOTO sort
ga: 
PRINT  "Geburtstag wird sortiert !"
GOTO sort
na:
PRINT "Namen werden alphabetisch sortiert !!!"
sort:
FOR a=1 TO d
FOR dd=1 TO d-1:ll=0:t1=0:t2=0
IF INSTR(1,da$(3,1),":")>0 THEN ll=1
IF mo=3 AND dt=1 OR mo=4 AND dt=1 THEN so1$=da$(3,dd):so2$=da$(3,dd+1)
IF dt>1 AND mo>4 AND mo<7 THEN mo=mo-2
IF mo=3 AND dt>1 OR mo=4 AND dt>1 THEN so1$=da$(5*1+(dt-2)+((dt-1)*(1-1)),dd):so2$=da$(5*1+(dt-2)+((dt-1)*(1-1)),dd+1)
IF dt>1 OR mo<5 OR mo>6 THEN GOTO sweiter
k1=1:k2=1:ws=0:so1$="":so2$=""
abr:
IF UCASE$(da$(5*k1+(dt-2)+((dt-1)*(k1-1)),dd))<>"W" THEN k1=k1+1:ws=1
IF k1>l(dd) AND mo=5 THEN so1$="0":ws=0
IF k1>l(dd) AND mo=6 THEN so1$="9999999999":ws=0
IF ws=1 THEN ws=0:GOTO abr
IF so1$="" THEN so1$=da$(5*k1+(-3+1)+((dt-1)*(k1-1)),dd)
abr2:
IF UCASE$(da$(5*k2+(dt-2)+((dt-1)*(k2-1)),dd+1))<>"W" THEN k2=k2+1:ws=1
IF k2>l(dd+1) AND mo=5 THEN so2$="0":ws=0
IF k2>l(dd+1) AND mo=6 THEN so2$="9999999999":ws=0
IF ws=1 THEN ws=0:GOTO abr2
IF so2$="" THEN so2$=da$(5*k2+(-3+1)+((dt-1)*(k2-1)),dd+1) 
sweiter:
IF mo=5 AND dt>1 THEN 
 IF VAL(
IF mo=3 AND ll=0 AND dt=1 THEN
 IF VAL(so2$)>VAL(so1$) THEN GOTO sein
END IF
IF mo=4 AND ll=0 AND dt=1 THEN
 IF VAL(so2$)<VAL(so1$) THEN GOTO sein
END IF
IF ll=1 AND dt=1 AND (mo=3 OR mo=4) THEN
 z1$=RIGHT$(STR$(VAL(so1$)),LEN(STR$(VAL(so1$)))-1)
 z2$=RIGHT$(STR$(VAL(so2$)),LEN(STR$(VAL(so2$)))-1)
 z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
 IF mo=3 AND VAL(z2$)>VAL(z1$) THEN GOTO sein
 IF mo=4 AND VAL(z2$)<VAL(z1$) THEN GOTO sein
END IF
IF mo=3 AND dt>1 THEN
 IF VAL(so1$)<VAL(so2$) THEN GOTO sein
END IF
IF mo=7 THEN IF UCASE$(da$(1,dd+1))<UCASE$(da$(1,dd)) THEN GOTO sein
IF mo=8 THEN d1$=RIGHT$(da$(2,dd),4):d1$=d1$+MID$(da$(2,dd),4,2):d1$=d1$+LEFT$(da$(2,dd),2):d2$=RIGHT$(da$(2,dd+1),4)+MID$(da$(2,dd+1),4,2)+LEFT$(da$(2,dd+1),2):IF VAL(d2$)<VAL(d1$) THEN GOTO sein
IF mo=6 AND ll=0 AND dt=1 THEN
 IF VAL(so2$)<VAL(so1$) THEN GOTO sein
END IF
IF mo=5 AND dt=1 AND ll=0 THEN
 IF VAL(so2$)>VAL(so1$) THEN GOTO sein
END IF
IF mo=6 AND dt=1 AND ll=1 THEN
 z1$=RIGHT$(STR$(VAL(LEFT$(so1$,2))),LEN(STR$(VAL(LEFT$(so1$,2))))-1)
 z2$=RIGHT$(STR$(VAL(LEFT$(so2$,2))),LEN(STR$(VAL(LEFT$(so2$,2))))-1)
 REM z1$=z1$+RIGHT$(so1$,4):z2$=z2$+RIGHT$(so2$,4)
 z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
 IF VAL(z2$)<VAL(z1$) THEN GOTO sein
END IF
IF mo=5 AND dt=1 AND ll=1 THEN
 z1$=RIGHT$(STR$(VAL(LEFT$(so1$,2))),LEN(STR$(VAL(LEFT$(so1$,2))))-1)
 z2$=RIGHT$(STR$(VAL(LEFT$(so2$,2))),LEN(STR$(VAL(LEFT$(so2$,2))))-1)
 z1$=z1$+RIGHT$(so1$,(LEN(so1$)-INSTR(so1$,":"))):z2$=z2$+RIGHT$(so2$,(LEN(so2$)-INSTR(so2$,":")))
 IF VAL(z2$)>VAL(z1$) THEN GOTO sein
END IF
IF mo=6 AND dt>1 THEN
 IF VAL(da$(5*1+(dt-2)+((dt-1)*(1-1)),dd+1))>VAL(da$(5*1+(dt-2)+((dt-1)*(1-1)),ddh)) THEN GOTO sein
END IF
GOTO send
sein:
 SWAP da$(1,dd+1),da$(1,dd)
 SWAP da$(2,dd+1),da$(2,dd)
 gr=l(dd):IF l(dd+1)>gr THEN gr=l(dd+1)
 FOR b=1 TO gr
  FOR c=1 TO dt
   SWAP da$(5*b+(-3+c)+((dt-1)*(b-1)),dd),da$(5*b+(-3+c)+((dt-1)*(b-1)),dd+1)
  NEXT c
  SWAP da$(5*b+(dt-2)+((dt-1)*(b-1)),dd),da$(5*b+(dt-2)+((dt-1)*(b-1)),dd+1)
  SWAP da$(5*b+(dt-1)+((dt-1)*(b-1)),dd),da$(5*b+(dt-1)+((dt-1)*(b-1)),dd+1)
  SWAP da$(5*b+dt+((dt-1)*(b-1)),dd),da$(5*b+dt+((dt-1)*(b-1)),dd+1)
  SWAP da$(5*b+dt+1+((dt-1)*(b-1)),dd),da$(5*b+dt+1+((dt-1)*(b-1)),dd+1)
 NEXT b:SWAP l(dd),l(dd+1)
send:
NEXT dd:NEXT a:
CLS:GOTO mn 
suchen:
LOCATE 1,1:PRINT  "Nach welchem Begriff soll ich suchen [Nur Name,Geburtstag,Datum oder Ort]"
LINE INPUT su$
IF su$="" THEN CLS:GOTO mn
CLS
FOR dd=1 TO d
IF UCASE$(LEFT$(da$(1,dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen
IF UCASE$(LEFT$(da$(2,dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen
FOR b=1 TO l(dd)
IF UCASE$(LEFT$(da$(5*l(dd)+(dt-1)+((dt-1)*(l(dd)-1)),dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen:b=l(dd)
IF UCASE$(LEFT$(da$(5*l(dd)+dt+((dt-1)*(l(dd)-1)),dd),LEN(su$)))=UCASE$(su$) THEN su=1:GOSUB ansehen:b=l(dd)
NEXT b:NEXT dd:SOUND 1200,18,255,0
IF su=0 THEN PRINT "Begriff nicht gefunden !!":
su=0:SLEEP:SLEEP:CLS:GOTO mn
eingabe:
IF d=0 THEN GOTO hinzu
LOCATE 1,1:PRINT "Was hinzufügen [Space],Stop [F1] oder ansehen [Return] ?"
a$=""
WHILE a$<>" " AND a$<>CHR$(13) AND a$<>CHR$(129) 
 a$=INKEY$
WEND 
CLS
IF a$=CHR$(13) THEN dd=1:GOTO ansehen
IF a$=CHR$(129) THEN CLS:GOTO mn
hinzu:
d=d+1
LOCATE 1,1:LINE INPUT "Name      :";da$(1,d)
IF da$(1,d)="" AND d>1 THEN d=d-1:CLS:GOTO mn
ff=0
OPEN "Geburtstag" FOR INPUT AS #1
gelesen:
INPUT#1,a$
IF INSTR(a$,".")>0 THEN MID$(a$,INSTR(a$,"."),1)=","
INPUT#1,b$
IF da$(1,d)=a$ THEN da$(2,d)=b$:ff=1
IF EOF(1)=0 AND ff=0 THEN gelesen
CLOSE 1
IF ff=0 THEN 
 BEEP:LINE INPUT "Geburtstag:";da$(2,d)
 IF da$(2,d)<>"" THEN
  OPEN "Geburtstag" FOR APPEND AS #1
   a$=da$(1,d)
   IF INSTR(a$,",")>0 THEN MID$(a$,INSTR(a$,","),1)="."
   PRINT#1,a$
   PRINT#1,da$(2,d)
  CLOSE 1
 END IF
ELSE
 ff=0:PRINT "Geburtstag:"da$(2,d)
END IF
dd=d
leist:
IF l(dd)=4*(fr-dt) THEN CLS:GOTO ansehen
l(dd)=l(dd)+1
b=0
FOR a=1 TO dt
 PRINT  l(dd)".Leistung im "di$(a)":";
 LINE INPUT da$(5*l(dd)+(-3+a)+((dt-1)*(l(dd)-1)),dd)
 IF da$(5*l(dd)+(-3+1)+((dt-1)*(l(dd)-1)),dd)="" AND l(dd)>1 THEN l(dd)=l(dd)-1:LINE (0,0)-(620,200),0,bf:GOTO ansehen
 REM IF dt>1 THEN
 REM   OPEN punktfile$(a) FOR INPUT AS #1
 REM  a$="999999999"
 REM  WHILE VAL(da$(5*l(dd)+(-3+a)+((dt-1)*(l(dd)-1)),dd))<VAL(a$)
 REM   IF EOF(1)=-1 THEN 
 REM    a$="00":c=0
 REM   ELSE
 REM    INPUT#1,a$:
 REM    IF LEN(a$)>2 THEN 
 REM     INPUT#1,c$:c=VAL(c$)
 REM    END IF
 REM   END IF
 REM  WEND
 REM CLOSE#1
 REM b=b+c
 REM END IF 
NEXT a
IF dt>1 THEN LINE INPUT "Punkte:" , da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)
REM IF dt>1 THEN PRINT  "Punkte:"b:da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)=STR$(b)
IF dt=1 THEN LINE INPUT "(T)raining oder (W)ettkampf ?";da$(5*l(dd)+(dt-2)+((dt-1)*(l(dd)-1)),dd)
da$(5*l(dd)+dt-1+((dt-1)*(l(dd)-1)),dd)=ort$
da$(5*l(dd)+dt+((dt-1)*(l(dd)-1)),dd)=ta$
LINE INPUT "Abzeichen:";da$(5*l(dd)+dt+1+((dt-1)*(l(dd)-1)),dd)
PRINT "Noch eine Leistung [Return] oder Ende [Space] ?"
a$=""
WHILE a$><" " AND a$><CHR$(13)
 a$=INKEY$
WEND
IF a$=CHR$(13) THEN LOCATE CSRLIN-1,1:PRINT "                                               ":LOCATE CSRLIN-1,1:GOTO leist
CLS
ansehen:
LOCATE 1,1
PRINT "Name       :"da$(1,dd)
PRINT "Geburtstag :"da$(2,dd)
PRINT "Gespeicherte Leistungen :"l(dd)
PRINT "Name ändern  = F1               Geburtstag ändern = F2"
IF su=0 THEN PRINT "Karte weiter = F6               Karte zurück      = F7"
PRINT "neue Leistung= Return           Stop              = Space"
PRINT "Leistungen ändern = 0 -"CHR$(47+l(dd))"
PRINT "Karte löschen = HELP"
a$=""
tast:
a$=INKEY$:IF a$="" THEN tast
IF a$=CHR$(139) THEN 
 LOCATE 11,1:PRINT "Wirklich löschen [RETURN] oder nicht [SPACE] ?"
 WHILE a$<>" " AND a$<>CHR$(13)
 a$=INKEY$
 WEND
 IF a$=" " THEN CLS:GOTO ansehen
 FOR za=dd TO d
  da$(1,za)=da$(1,za+1)
  da$(2,za)=da$(2,za+1)
  l(za)=l(za+1)
  FOR zb=1 TO l(za)
   FOR zc=1 TO dt
    da$(5*zb+(-3+zc)+((dt-1)*(zb-1)),za)=da$(5*zb+(-3+zc)+((dt-1)*(zb-1)),za+1)
   NEXT zc
   FOR zc=-2 TO 1
    da$(5*zb+(dt+zc)+((dt-1)*(zb-1)),za)=da$(5*zb+(dt+zc)+((dt-1)*(zb-1)),a)
   NEXT zc
  NEXT zb
 NEXT za
 d=d-1
 CLS:IF dd>d THEN dd=d
 GOTO ansehen
END IF
IF a$=" "AND su=0 THEN CLS:GOTO mn
IF a$=" "AND su=1 THEN CLS:RETURN
IF a$=CHR$(13) THEN GOTO leist
IF a$=CHR$(134) AND su=0 THEN CLS:IF dd=d THEN GOTO eingabe :ELSE dd=dd+1:GOTO ansehen
IF a$=CHR$(135) AND su=0 THEN CLS:IF dd=1 THEN dd=d:GOTO ansehen :ELSE dd=dd-1:GOTO ansehen
IF a$=CHR$(129) THEN 
 LINE INPUT "Neuer Name :";a$:CLS:IF a$="" THEN GOTO ansehen
 da$(1,dd)=a$:GOTO ansehen
END IF
IF a$=CHR$(130) THEN
 LINE INPUT "Neuer Geburtstag :";a$:CLS:IF a$="" THEN GOTO ansehen
 da$(2,dd)=a$:
 OPEN "Geburtstag" FOR INPUT AS #1
 OPEN "Birthday" FOR OUTPUT AS #2
  geschrieben:
  INPUT#1,a$
  MID$(a$,INSTR(a$,"."),1)=","
  INPUT#1,b$
  IF a$=da$(1,dd) THEN
   MID$(a$,INSTR(a$,","),1)="."
   PRINT#2,a$
   PRINT#2,da$(2,dd)
  ELSE
   MID$(a$,INSTR(a$,","),1)="."
   PRINT#2,a$
   PRINT#2,b$
  END IF
  IF EOF(1)=0 THEN geschrieben
 CLOSE 2
 CLOSE 1
 KILL "Geburtstag"
 NAME "Birthday" AS "Geburtstag"
 GOTO ansehen
END IF
IF a$<"0" OR a$>CHR$(47+l(dd)) THEN GOTO tast
le=ASC(a$)-47
le2:
PRINT 
FOR a=1 TO dt
PRINT le".Leistung im "di$(a)":"da$(5*le+(-3+a)+((dt-1)*(le-1)),dd)
a$=""
WHILE a$=""
 a$=INKEY$
WEND
IF a$=" "THEN 
 LOCATE CSRLIN-1,16+LEN(di$(a))+LEN(STR$(l(le)))
 LINE INPUT;a$:PRINT 
 IF a$<>"" THEN da$(5*le+(-3+a)+((dt-1)*(le-1)),dd)=a$
END IF
NEXT a
IF dt>1 THEN PRINT "Punkte:";: :ELSE PRINT "(T)raining oder (W)ettkampf : ";
PRINT  da$(5*le+(dt-2)+((dt-1)*(le-1)),dd)
a$=""
WHILE a$=""
 a$=INKEY$
WEND
IF a$=" " THEN
 IF dt>1 THEN LOCATE CSRLIN-1,8::ELSE LOCATE CSRLIN-1,32
 LINE INPUT;a$:PRINT 
 IF a$<>"" THEN da$(5*le+(dt-2)+((dt-1)*(le-1)),dd)=a$
END IF
PRINT "Ort:"da$(5*le+dt-1+((dt-1)*(le-1)),dd)
a$=""
WHILE a$=""
 a$=INKEY$
WEND
IF a$=" "THEN
 LOCATE CSRLIN-1,5
 LINE INPUT;a$:PRINT 
 IF a$<>"" THEN da$(5*le+dt-1+((dt-1)*(le-1)),dd)=a$
END IF
PRINT "Datum:"da$(5*le+dt+((dt-1)*(le-1)),dd)
a$=""
WHILE a$=""
 a$=INKEY$
WEND
IF a$=" "THEN
 LOCATE CSRLIN-1,7
 LINE INPUT;a$:PRINT 
 IF a$<>"" THEN da$(5*le+dt+((dt-1)*(le-1)),dd)=a$
END IF
PRINT "Abzeichen:"da$(5*le+dt+1+((dt-1)*(le-1)),dd)
a$=""
WHILE a$=""
 a$=INKEY$
WEND
IF a$=" " THEN
 LOCATE CSRLIN-1,11
 LINE INPUT;a$:PRINT 
 IF a$<>"" THEN da$(5*le+dt+1+((dt-1)*(le-1)),dd)=a$
END IF
PRINT :PRINT "Weiter : RETURN , Stop : SPACE"
wt:
a$=INKEY$
IF a$<>" " AND a$<>CHR$(13) THEN wt 
IF a$=" " THEN CLS:GOTO ansehen
IF le=l(dd) THEN PRINT "Schluss der Leistungen !!":FOR a=1 TO 500:NEXT a:CLS:GOTO ansehen
le=le+1:GOTO le2